00100	C  *****  NSCOL  FEB 28 73 -- FOR EXPORT -- WRITES ON MAGTAPE OR DSK.  
00200	C  ****** LOAD WITH CMUIO.REL  *********
00300	C   TO WRITE ON DSK: BIGBIT←1; OR RCDFLG←1;    TO WRITE ON TAPE: BIGBIT←-1;
00400	C  BIGBIT←>1; WRITES ON DSK, 4TH LETTER OF NAME IS SET BY NUMBER.
00500	C   IF RCDFLG IS NOT 0 OR 1, ONE LONG FILE IS WRITTEN. PLAY WITH 'PLAY'.
00600		SUBROUTINE SMPLS(LSBUF,ISBCNT,IBOTT,MAXAMP,BIGBIT,RCDFLG)
00700		COMMON JSB(10)
00800		DIMENSION MX(3),INM(3),IBOTT(1),MQ(5)
00900		EQUIVALENCE (JSB(3),JSB3),(JSB(4),JSB4),(JSB(5),JSB5)
01000		DATA (MX(JSC),JSC=1,2)/'AMPL.=0 /'/,INM(2)/' AMP='/
01200		DATA JSAVE/33000/
01300		IF(J)GO TO 6
01400	86	K=-1
01500	   	IEND=-1
01600		LNM=0
01700		NUM=0
01800		IMAX=50000
01900		IF(BIGBIT.EQ.0)GO TO 8
02000		IF(RCDFLG.GT.8000)JSAVE=RCDFLG
02100		RCDFLG=0
02200	C   WILL SAVE AFTER C.33K UNLESS RCDFLG>8K
02300	87	IF(BIGBIT.LT.0)GO TO 88
02400		IF(BIGBIT.LT.1)GO TO 8
02500		JSC=BIGBIT-1.
02600		LNM='MUSAA'+256*JSC
02700		BIGBIT=.5
02800	C  NAME CHANGE ONLY WORKS WHEN WRITING ON DSK.
02900		J=0
03000		GO TO 87
03100	88	K=0
03300		KBIT=2
03400		GO TO 9
03500	8	KBIT=3.-BIGBIT
03600		IF(RCDFLG.GT.1.)RCDFLG=-1.
03700	9	IF(RCDFLG.NE.-1)IBOTT(1024)=0
03800		JSB(2)=KBIT
03900	C   KBIT=3, 12-BITS.  KBIT=2, 18-BITS. JSB(2) PASSES KBIT TO CONVRT.
04000		IF(J.EQ.1)GO TO 5
04100		JNM='MUSAA'
04200		IF(LNM.NE.0)JNM=LNM
04300	1	INM(1)=JNM
04400		KNM=JNM
04500		J=1
04600	5	IF(INM(1).LE.JNM+50)GO TO 2
04700		JNM=JNM+256
04800		IF(JNM.LE.KNM+6400)GO TO 3
04900		KNM=JNM+26112
05000		JNM=KNM
05100	C   RAISES 'AAAZA' TO 'AABAA'
05200	3	INM(1)=JNM
05300	C   NAMES GO FROM 'AAAAA' TO 'AAZZZ': MUSAA,MUSAB,MUSAC,ETC.
05400	2	IF(K)GO TO 33
05500		CALL GETTAP
05600		GO TO 34
05700	33	CALL PUTFIL(INM(1))
05800	34	J=-1
05850		JSC=LSBUF
05875	C  IF RCDFLG←-1; LSBUF=1024 -- OTHERWISE LSBUF=1023 AND LAST WD(1024) IS AMP.
05900		IF(RCDFLG)GO TO 666
06000		JSC=LSBUF+1
06100	C  WRITES LSBUF+1 WDS.  THE '+1' WILL HAVE MAXAMP IN LAST BUFFER.
06200		JSB(1)=JSC
06300		JSB3=INM(1)
06400		JSB4=9999
06500		JSB5=9998
06600		IF(K)GO TO 66
06700		CALL TOTAPE(JSB(1),128)
06800		GO TO 6
07000	666	IMAX=2050
07100		GO TO 6
07200	66	CALL FASTOU(JSB(1),128)
07300	6	IF(ISBCNT.NE.0)GO TO 7
07400		IF(NUM+LSBUF.LT.JSAVE.OR.RCDFLG)GO TO 4
07500	10	IBOTT(JSC)=MAXAMP
07600		IF(MAXAMP.EQ.0)IBOTT(JSC)=1
07700	C  IF 0, THEN NO WAY TO FIND END OF FILE IN OTHER PROGS.
07800	5444	IEND=0
07900		GO TO 4
08000	7	IF(RCDFLG)GO TO 5444
08100		IBOTT(LSBUF)=(ISBCNT-1)/KBIT       
08200		MAXAMP=-MAXAMP
08300	C  LAST WRD OF LSBUF IS USED FOR WDCNT OF FREE SPACE IN LAST BUFFER.
08400	C  -MAXAMP TELLS CONVRT IT'S THE LAST BUFFER.
08500		GO TO 10
08600	4	NUM=NUM+LSBUF
08700		IF(MAXAMP.EQ.0)CALL MESS(MX)
08900		IF(MAXAMP.LT.IMAX)GO TO 4444
09000	C  IABS(MAXAMP) WON'T WORK 1ST TIME AROUND!!!!!!!⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗
09100	C   49999 IS MAXIMUM AMPL. POSSIBLE (ARBITRARY NUMBER.)
09200		CALL MESS(INM)
09300		CALL MESS(INM)
09400		CALL MESS(INM)
09500		CALL MESS(INM)
09600		CALL PNUM(MAXAMP)
09700	        GO TO 227
09800	4444	IF(K)GO TO 44
09900		 CALL TOTAPE(IBOTT(1),JSC)
10000		GO TO 45
10100	44	CALL FASTOU(IBOTT(1),JSC)
10200	45	IF(IEND)RETURN
10300		IF(RCDFLG)GO TO 224
10400	22	JSB(1)=-1
10500		JSB3=INM(1)
10600		JSB4=9999
10700		JSB5=9998
10800		IF(K)GO TO 222
10900		CALL TOTAPE(JSB(1),128)
11000	C    '-1' MARKS END OF THIS BATCH OF DATA.
11100	C    '9999' IDENTIFIES IT AS MUSIC DATA WHEN TAPE IS READ.
11200		CALL FINTAP
11300		CALL BACKSP
11400		CALL BACKSP
11500		GO TO 223
11600	224	K=NUM/LSBUF
11700		J=0
11800		NUM=4-K-(K/4*4)
11900	C  MAKES MULTIPLES OF 4K.
12000		J=0
12200	2251	DO 225 K=1,1024
12300	225	IBOTT(K)=0
12400	2261	DO 226 K=1,NUM
12500	226	CALL FASTOU(IBOTT(1),LSBUF)
12600	227	CALL FINFIL
12700		GO TO 2221
12800	222	CALL FASTOU(JSB(1),128)
12900		CALL FINFIL
13000	223	J=1
13100	CC2231	IF(RCDFLG.GE.0)CALL SAVER
13150	2231	JSB(1)=0
13200	2221	CALL MESS(INM)
13300		CALL PNUM(MAXAMP)
13400		INM(1)=INM(1)+2
13500		RETURN
13600		END
13700	
14000	
14010		SUBROUTINE READIN(A,B,C,D,E)
14020	C  THIS IS A DUMMY. WILL BE DEVELOPED LATER.
14030		END
14040	
14100		SUBROUTINE SEG(FUNC)
14200	C  TYPE AMPL, STEP# (UP TO STEP 512). SAME FORMAT AS GEN 1 IN MUSIC5.
14300		DIMENSION FUNC(512),A(4),MJ(7)
14400		COMMON K,STEP,AMP1,AMP2,DIF,IT,IS,ST,STPS,RK
14500		DATA (A(K),K=1,3)/'SEG ARRAY FULL/'/
14600		DATA (MJ(K),K=1,6)/'USE 100 STEPS FOR SEG!!!    '/
14700		CALL MESS(MJ)
14800	C   REMOVE ABOVE LATER********
15000		AMP1=0
15100		ST=0
15200	1	CALL RDNUM(AMP2)
15300		CALL RDNUM(STEP)
15400		IF(STEP.GT.1.)GO TO 3
15500		AMP1=AMP2
15600		GO TO 1
15700	C  STEP=1 AND STEP=0 ARE CONSIDERED THE SAME.
15800	3	DIF=AMP2-AMP1
15900	5	IT=ST
15950		IS=STEP*5.120+.0001
15975		STEP=IS
16000	 	STPS=STEP-ST
16100		IS=STPS
16150		IF(IS+IT.GT.512)GO TO 6
16200		ST=STEP
16300		IF(ST.EQ.0)STEP=1.
16400		DO 2 K=1,IS
16600		RK=K
16700	2	FUNC(K+IT)=AMP1+DIF*RK/STPS
16800		AMP1=AMP2
16900	      	ST=STEP
17100		IF(STEP.LT.512)GO TO 1
17300	1102	CALL MESS(A)
17310	CC	FUNC(1)=0.0
17400		RETURN
17500	6	K=1
17550	C  NEXT TO READ IN FULL ARRAYS
17600	8	CALL RDNUM(RK)
17700	7	FUNC(K)=RK
17800		K=K+1
17900		IF(K.LE.512)GO TO 8
18000		GO TO 1102
18100		END
18200	
18300		SUBROUTINE SYNTH (FUNC)
18400	C    AFTER 'SYNTH(F1);'  TYPE 99= TO USE  H,A,P,K: OTHERWISE
18500	C    H,A ONLY.  TYPE 999 TO END. NORMALIZATION IS AUTOMATIC.
18600		DIMENSION FUNC(512),F(5)
18700		COMMON I,XX,X,H,K,CON,XK,FAC,AMP,Y
18800		DATA (F(I),I=1,4)/'SYNTH ARRAY FULL/'/
18900		DO 15 I=1,512
19000	15	FUNC(I)=0.0
19100	 	CALL RDNUM(XX)
19200		IF(XX.EQ.99)XX=-99
19300		FAC=360./512.
19400		H=XX
19500		IF(XX)CALL RDNUM(H)
19600	16	CALL RDNUM(AMP)
19700		IF(XX)GO TO 1016
19800		X=0
19900		CON=0
20000		GO TO 2016
20100	1016	CALL RDNUM(X)
20200		X=X*512./360.+1.0
20300		CALL RDNUM(CON)
20400	2016	DO 17 J=1,512
20500		XK=SIND(X*FAC)*AMP+CON
20600		IF(CON.LT.100.0)GO TO 1
20700		FUNC(J)=(XK-100.)*FUNC(J)
20800		GO TO 2
20900	1	FUNC(J)=FUNC(J)+XK
21000	2	X=X+H
21100		IF(X.LE.512.)GO TO 17
21200		X=X-512.
21300	17	CONTINUE
21400		CALL RDNUM(H)
21500		IF(H.NE.999.)GO TO 16
21600	2200	X=FUNC(1)
21700		DO 19 I=2,512
21800		H=ABS(FUNC(I))
21900	19	IF(X.LT.H)X=H
22000		DO 20 I=1,512
22100	20	FUNC(I)=FUNC(I)/X
22200		CALL MESS(F)
22300		RETURN
22400		END
22500	C   ***********  DUR2 1969  *********
22550	C  SEE SCORE.MAN FOR USE OF DUR2(X,Y,Z)
22600		FUNCTION DUR(P2,SPEED,CHNS)
22700		COMMON P,ISR,NC,IDUR,ID,IP(5)
22800		DATA IP/20000,25000,10000,50000,100000/
22900		P=P2
23000		ISPD=SPEED
23100		NC=CHNS*30+.3
23200	3	IDUR=P*10000+.5
23300	5	IDUR=(IDUR*IP(ISPD))/1000
23400	6	ID=IDUR/NC
23500	7	ID=IDUR-ID*NC
23600		IF(ID.EQ.0)GO TO 1
23700		P=P+.0001
23800		GO TO 3
23900	1	DUR=P
24000		RETURN
24100		END